Gold Medal Software 1/Gold Medal Software Volume 1 (Gold Medal) (1994).iso/prog/tpwprog3.arj/UMOVE.PAS

Pascal/Delphi Source File | 1992-07-02 | 10.5 KB | 353 lines

{******************************************************************}
{                                                                  }
{     Mancala                                                      }
{     Turbo Pascal for Windows                                     }
{     Copyright (c) 1991 by Swan Software. All rights reserved.    }
{                                                                  }
{******************************************************************}

{ umove.pas -- Legal-move generator for Mancala }

unit UMove;

interface

uses UGlobals, UEval;


var

{- Set MaxMoveIndex to 0 before calling search.  After the search,
this variable equals the largest value reached by MoveIndex--a
debugging device for determining the amount of stack space used (the
game's stack, that is, not the processor's. }

  MaxMoveIndex: Integer;


procedure MoveGen(var Position: Boardrec; Level: Integer;
  var MoveList: ListRec);

function CupsEmpty(var Gameboard: Board; FirstCup,
  LastCup: CupIndex): Boolean;

procedure MakeMove(var Position: BoardRec; Level: Integer;
  Move: OneMove; var Score: Integer);

function LegalMove(Themove: Onemove; MoveList: ListRec): Boolean;


implementation

{- The following ListMoves procedure creates a list of legal moves
for board cup index range from StartCup to EndCup. Returns MoveList
fields equal to the first move of the MoveList on the MoveStack. If
MoveList.Count = 0, then there are no legal moves for this player. This
function is called by MoveGen. Do not call it directly.

Each move is associated with a Gameboard. Both the move and the
resulting Gameboard are saved in MoveStack and BoardStack arrays by
this routine. The Level is used to make each move and assign a
preliminary score. Odd levels are for the computer's moves; even
levels for human moves. The Gameboard parameter represents the
current position.

Note: A stack overflow, although prevented, causes no error--the
computer will just think that no more moves are possible. Obviously,
this will affect the computer's ability to find the best move, but it
won't cause the program to halt. }

procedure ListMoves(var Position: BoardRec; Level: Integer;
  StartCup: CupIndex; EndCup: CupIndex; var MoveList: ListRec);
var
  I: Integer;
begin
  with Position, MoveList do
  begin
    FirstIndex := MoveIndex + 1;  { Index to first move of move list }
    Count := 0;                   { Initialize count (empty list) }
    if not Win then
      for I := StartCup to EndCup do
        if Gameboard[I] > 0 then
          if MoveIndex < maxStack then
          begin
            Inc(MoveIndex); { Advance stack ptr }
            {- Copy current Gameboard to BoardStack }
            Move(Gameboard, BoardStack[MoveIndex], Sizeof(Board));
            with MoveStack[MoveIndex] do
            begin
              Move := I;    { Save move }
              BoardIndex := MoveIndex;  { Points to game board after move }
              MakeMove(BoardStack[MoveIndex], Level, Move, Score);
            end;
            Inc(Count);
          end;
    LastIndex := FirstIndex + Count - 1;
    {- Record highest MoveIndex value for debugging amount
       of stack space used during search. }
    if MoveIndex > MaxMoveIndex then
      MaxMoveIndex := MoveIndex;
  end;
end;


{- Sort moves in ascending order, from the lowest to the highest
score, bringing the worst positions for human moves to the front of
the move list. }

{- Reference: Quicksort algorithm from Algorithms+Data
Structures=Programs by Niklaus Wirth, pg 79. L = MoveStack index of
first move of MoveList; R = MoveStack index of last move. Assume R > L. }

procedure SortAscending(L, R: Integer);
var
  I, J: Integer; X, W: MoveRec;
begin
  I := L;
  J := R;
  X := MoveStack[(L + R) div 2];
  repeat
    while Movestack[I].Score < X.Score do Inc(I);
    while X.Score < Movestack[J].Score do Dec(J);
    if I <= J then
    begin
      W := Movestack[I];
      Movestack[I] := Movestack[J];
      Movestack[J] := W;
      Inc(I);
      Dec(J);
    end;
  until I > J;
  if L < J then SortAscending(L, J);
  if I < R then SortAscending(I, R);
end;


{- Sort moves in descending order, from the highest to the lowest
score, bringing the best positions for computer moves to the front of
the move list. }

procedure SortDescending(L, R: Integer);
var
  I, J: Integer; X, W: MoveRec;
begin
  I := L;
  J := R;
  X := MoveStack[(L + R) div 2];
  repeat
    while Movestack[I].Score > X.Score do Inc(I);
    while X.Score > Movestack[J].Score do Dec(J);
    if I <= J then
    begin
      W := Movestack[I];
      Movestack[I] := Movestack[J];
      Movestack[J] := W;
      Inc(I);
      Dec(J);
    end;
  until I > J;
  if L < J then SortDescending(L, J);
  if I < R then SortDescending(I, R);
end;


procedure MoveGen(var Position: BoardRec; Level: Integer;
  var MoveList: ListRec);

{- Generate list of legal moves for this search level. To create a
move list outside of the search procedure, set level to 1 for
computer moves, 0 for human. MoveList.Count = 0 indicates there are no
legal moves for this player. The Gameboard represents the current
position either during play or a position reached during simulated
play. The call to ListMoves generates the list of legal moves. After
that, if there are at least two moves on the list, it is sorted by
preliminary scores in ascending order for human moves and descending
order for computer moves. }

begin
  if Odd(Level) then
  begin
    ListMoves(Position, Level, CompFirstCup, CompLastCup, MoveList);
    with MoveList do if Count > 1 then
      SortDescending(FirstIndex, LastIndex);
  end else
  begin
    ListMoves(Position, Level, HumanFirstCup, HumanLastCup, MoveList);
    with MoveList do if Count > 1 then
      SortAscending(FirstIndex, LastIndex);
  end;
end;


{- Return true if all cups from FirstCup to LastCup are empty. }

function CupsEmpty(var Gameboard: Board;
  FirstCup, LastCup: CupIndex): Boolean;
var
  I: Integer;
begin
  for I := FirstCup to LastCup do
    if Gameboard[I] > 0 then
    begin
      CupsEmpty := false;
      Exit;
    end;
  CupsEmpty := true;
end;


{- Move all stones from FirstCup to Lastcup into this Kalah. This
action occurs only when the opposite side's cups are all empty. }

procedure MoveAllPebbles(var Gameboard: Board; FirstCup, LastCup,
  Kalah: CupIndex);
var
  I, Pebbles: Integer;
begin
  Pebbles := 0;
  for I := FirstCup to LastCup do
  begin
    Pebbles := Pebbles + Gameboard[I];
    Gameboard[I] := 0;
  end;
  Gameboard[Kalah] := Gameboard[Kalah] + Pebbles;
end;


{- Make this move on the global game board. Assume that the move
is legal. Returns GoAgain = true if player can make another move.
Otherwise, returns GoAgain = false. Odd Levels = moves for computer.
Even Levels = moves for opponent (human). }

procedure MakeMove(var Position: BoardRec; Level: Integer;
  Move: OneMove; var Score: Integer);
var
  Cup: CupIndex;
  Pebbles: Integer;
  PlayerKalah: CupIndex;
  OpponentKalah: CupIndex;
  CaptureCup: CupIndex;
  FirstCup: CupIndex;
  LastCup: CupIndex;
  CupWasEmpty: Boolean;
  CapturedPebbles: Integer;
begin

{- Initialize local variables }

  if Odd(Level) then
  begin { Make move for computer }
    PlayerKalah := CompKalah;
    OpponentKalah := HumanKalah;
    FirstCup := CompFirstCup;
    LastCup := CompLastCup;
  end else
  begin { Make move for human }
    PlayerKalah := HumanKalah;
    OpponentKalah := CompKalah;
    FirstCup := HumanFirstCup;
    LastCup := HumanLastCup;
  end;


{- Make the move, distributing pebbles in a counter-clockwise direction. }

  with Position do
  begin
    Cup := Move;
    Pebbles := Gameboard[Move];
    Gameboard[Move] := 0;
    while Pebbles > 0 do
    begin
      if Cup = MaxCupIndex then
        Cup := 0
      else
        Inc(Cup);
      if Cup <> OpponentKalah then  { Skip opponent's kalah }
      begin
        CupWasEmpty := Gameboard[Cup] = 0;
        Inc(Gameboard[Cup]);
        Dec(Pebbles);
      end;
    end;


{- Check for go-again if last pebble drops into player's own kalah. }

    GoAgain := (Cup = PlayerKalah);


{- Check for captures when player's last stone drops into one of
the player's own empty cups and an opposite cup contains pebbbles. }

    if not GoAgain then
      if CupWasEmpty then
        if FirstCup <= Cup then
          if Cup <= LastCup then
          begin  { Capture }
            CaptureCup := MaxCups - Cup;
            CapturedPebbles := Gameboard[CaptureCup];
            if CapturedPebbles > 0 then
            begin
              Gameboard[PlayerKalah] :=
                Gameboard[PlayerKalah] + CapturedPebbles + 1;
              Gameboard[CaptureCup] := 0;
              Gameboard[Cup] := 0;
            end;
          end;


{- Check for special condition where either side's cups are all
empty. In this case, unless the side that has gone out has won, the
opposite side moves all his pebbles into his kalah and wins. }

    if CupsEmpty(Gameboard, CompFirstCup, CompLastCup) then
    begin
      if Gameboard[Compkalah] < PebblesDiv2 then
        MoveAllPebbles(Gameboard, HumanFirstCup, HumanLastCup, HumanKalah);
    end else
    if CupsEmpty(Gameboard, HumanFirstCup, HumanLastCup) then
    begin
      if Gameboard[HumanKalah] < PebblesDiv2 then
        MoveAllPebbles(Gameboard, CompFirstCup, CompLastCup, CompKalah);
    end;
  end;


{- Evaluate resulting position. This must be done here so that the
win field is properly set when the main program calls MakeMove. This
has to be done anyway for each position, so it may as well be here. }

  Score := BoardValue(Position, Level);

end;


{- Return true if move is one of the moves on this MoveList.
Never call this function if MoveList.Count = 0. This function is used
to restrict human to making legal moves. The computer never calls it
during the search for its own best move. }

function LegalMove(TheMove: OneMove; MoveList: ListRec): Boolean;
var
  I: StackRange;
begin
  with MoveList do
    for I := FirstIndex to LastIndex do
      if TheMove = MoveStack[I].Move then
      begin
        LegalMove := true;
        Exit;
      end;
  LegalMove := false;
end;


end.


{ ----------------------------------------------------------------
  Copyright (c) 1991 by Swan Software. All rights reserved.
  Revision 1.00    Date: 8/21/1991
  ---------------------------------------------------------------- }